home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
C64
/
G-Games
/
(c)gb.d64
/
montana.c
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2007-02-04
|
11KB
|
419 lines
1 REM PONZO/WATERLOO/1983
2 :
4 POKE56,7*16+15:POKE55,0:CLR
5 DIMC(3,12),CN(3,12),CY(3,12)
6 PASS=1:CRT=1024:WD=40
7 GOSUB50000:REM* TITLE
8 GOSUB10000:REM* INSTRUCTIONS
9 GOSUB62000:PRINTP$
10 GOSUB4000:REM* DEFINE CARD CORNERS
20 GOSUB4100:REM* DRAW CARD OUTLINES
30 GOSUB2000:REM* DEAL 52 CARDS
40 GOSUB4200:REM* DELAY
60 GOSUB4300:REM* REMOVE ACE EXTERIORS
70 GOSUB4200:REM* DELAY
80 GOSUB4400:REM* REMOVE ACE INTERIORS
90 GOSUB4500:REM* CARD TO BE MOVED?
100 GOSUB200:REM* IDENTIFY CARD CHOSEN
110 GOSUB4600:REM* FIND CORRECT SPACE
120 IFQQ=0THEN90:REM* QQ=0? BAD CHOICE
130 GOSUB280:REM* REMOVE CHOSEN CARD
140 GOSUB340:REM* INSERT IN SPACE
150 GOSUB20000:REM*NEXT PASS?..NQ=1
160 IFNQ=0THEN90
165 GOTO2300 :REM*CARDS RETAINED?
170 GOSUB2800:REM* PRINT"NEXT PASS"
180 GOSUB2500:REM*DEAL FOR NEXT PASS
190 GOTO40
200 REM*********************
201 REM** IDENTIFY CARD: ***
202 REM** N$=CARD NUMBER ***
203 REM** Y$=SUIT ***
204 REM*********************
205 N$=LEFT$(A$,1):Y$=MID$(A$,2,1)
206 IFN$="2"THENGOSUB3000:GOTO90
210 IFN$="K"THENK=17:K1=11:GOTO260
220 IFN$="Q"THENK=10:K1=17:GOTO260
230 IFN$="J"THENK=20:K1=10:GOTO260
240 IFN$="T"THENK=57:K1=20:GOTO260
250 K1=ASC(N$):K=K1-1
260 RETURN
278 REM***************************
279 REM* *
280 REM* REMOVE CARD SELECTED *
281 REM* *
282 REM***************************
300 FORII=0TO3:FORJJ=0TO12
310 IFCN(II,JJ)<>K1THEN325
315 IFCY(II,JJ)<>ASC(Y$)-128THEN325
320 I=II:J=JJ:A=I:B=J:II=3:JJ=12
325 NEXT
326 NEXT
330 GOSUB500:GOSUB550
335 CN(I,J)=-1:CY(I,J)=-1:RETURN
338 REM***************************
339 REM* *
340 REM* INSERT CARD SELECTED *
341 REM* *
342 REM***************************
343 I=SI(LL):J=SJ(LL):GOSUB600
345 SI(LL)=A:SJ(LL)=B
355 CN(I,J)=K1:CY(I,J)=ASC(Y$)-128
370 RETURN
500 REM*******************************
501 REM* *
502 REM* REMOVE EXTERIOR OF A CARD *
503 REM* *
504 REM*******************************
505 POKESID+4,17:POKESID+1,20
510 POKEC(I,J),32:POKEC(I,J)+1,32:POKEC(I,J)+2,32:POKEC(I,J)-WD,32
520 POKEC(I,J)-WD+2,32:POKEC(I,J)-2*WD,32:POKEC(I,J)-2*WD+2,32
530 POKEC(I,J)-3*WD,32:POKEC(I,J)-3*WD+1,32:POKEC(I,J)-3*WD+2,32
535 POKESID+1,0
540 RETURN
548 REM*******************************
549 REM* *
550 REM* REMOVE INTERIOR OF A CARD *
551 REM* *
552 REM*******************************
555 POKESID+4,33:POKESID+1,10
560 POKEC(I,J)-2*WD+1,32:POKEC(I,J)-WD+1,32
565 POKESID+1,0
570 RETURN
600 REM*******************
601 REM* *
602 REM* INSERT A CARD *
603 REM* *
604 REM*******************
610 GOSUB1000
620 POKEC(I,J)-2*WD+1,K1:POKEC(I,J)-WD+1,ASC(Y$)-128
630 RETURN
1000 REM***********************
1001 REM* *
1002 REM* DEAL A BLANK CARD *
1003 REM* *
1004 REM***********************
1010 POKEC(I,J),74:POKEC(I,J)+1,64:POKEC(I,J)+2,75:POKEC(I,J)-WD,93
1020 POKEC(I,J)-2*WD,93:POKEC(I,J)-WD+2,93:POKEC(I,J)-2*WD+2,93
1030 POKEC(I,J)-3*WD,85:POKEC(I,J)-3*WD+1,64:POKEC(I,J)-3*WD+2,73
1040 RETURN
2000 REM*******************
2001 REM* *
2002 REM* DEAL 52 CARDS *
2003 REM* *
2004 REM*******************
2010 C$="2[193]3[193]4[193]5[193]6[193]7[193]8[193]9[193]T[193]J[193]Q[193]K[193]A[193]"
2020 C$=C$+"2[211]3[211]4[211]5[211]6[211]7[211]8[211]9[211]T[211]J[211]Q[211]K[211]A[211]"
2030 C$=C$+"2[218]3[218]4[218]5[218]6[218]7[218]8[218]9[218]T[218]J[218]Q[218]K[218]A[218]"
2040 C$=C$+"2[216]3[216]4[216]5[216]6[216]7[216]8[216]9[216]T[216]J[216]Q[216]K[216]A[216]"
2045 POKESID+4,17:POKESID+24,15:FORI=0TO3:FORJ=R(I)TO12
2050 R=2*INT(LEN(C$)*RND(0)/2+1)-1
2055 POKESID+1,5*(I+1)*J
2060 N$=MID$(C$,R,1):Y$=MID$(C$,R+1,1)
2070 IFR>1THENT$=LEFT$(C$,R-1):GOTO2090
2080 T$=""
2090 C$=T$+MID$(C$,R+2)
2100 IFN$="A"THENK=1:GOTO2110
2101 IFN$="K"THENK=11:GOTO2110
2102 IFN$="Q"THENK=17:GOTO2110
2103 IFN$="J"THENK=10:GOTO2110
2104 IFN$="T"THENK=20:GOTO2110
2105 K=ASC(N$)
2110 POKEC(I,J)-2*WD+1,K:POKEC(I,J)-WD+1,ASC(Y$)-128
2115 CN(I,J)=K:CY(I,J)=ASC(Y$)-128
2120 NEXT:NEXT:POKESID+1,0:RETURN
2300 REM******************************
2301 REM*
2302 REM* # OF"CORRECT"CARDS/NEXT PASS
2303 REM*
2304 REM******************************
2305 R(0)=0:R(1)=0:R(2)=0:R(3)=0:CJ=0
2306 IFPASS>TTTHENGOSUB21000:GOTO20070
2310 FORI=0TO3
2315 IFCN(I,0)=50THENSU(I)=CY(I,0):GOSUB2400:CJ=CJ+R(I)
2320 NEXT
2325 IFCJ=48THEN63130:REM* A WIN!
2330 P$="PASS"+STR$(PASS)
2335 P$=P$+" OF"+TT$+"[144]"
2340 GOTO170
2400 REM******************************
2401 REM*
2402 REM* # OF"CORRECT"CARDS IN ROW *
2403 REM*
2404 REM******************************
2405 Q=0:R(I)=1
2410 FORJ=1TO7
2415 IFCN(I,J)<>CN(I,J-1)+1ORCY(I,J)<>CY(I,J-1)THENJ=7:Q=1:GOTO2425
2420 R(I)=R(I)+1
2425 NEXT:J=7:IFQ=1THENRETURN
2430 IFCN(I,J+1)<>20ORCY(I,J+1)<>CY(I,J)THENRETURN
2435 R(I)=R(I)+1:J=J+1
2440 IFCN(I,J+1)<>10ORCY(I,J+1)<>CY(I,J)THENRETURN
2445 R(I)=R(I)+1:J=J+1
2450 IFCN(I,J+1)<>17ORCY(I,J+1)<>CY(I,J)THENRETURN
2455 R(I)=R(I)+1:J=J+1
2460 IFCN(I,J+1)<>11ORCY(I,J+1)<>CY(I,J)THENRETURN
2465 R(I)=R(I)+1
2470 RETURN
2500 REM**********************
2501 REM* *
2502 REM* DEAL FOR NEXT PASS *
2503 REM* *
2504 REM**********************
2505 C$="":C1=0:C2=0:C3=0:C4=0
2506 C1$="2[193]3[193]4[193]5[193]6[193]7[193]8[193]9[193]T[193]J[193]Q[193]K[193]A[193]"
2507 C2$="2[211]3[211]4[211]5[211]6[211]7[211]8[211]9[211]T[211]J[211]Q[211]K[211]A[211]"
2508 C3$="2[218]3[218]4[218]5[218]6[218]7[218]8[218]9[218]T[218]J[218]Q[218]K[218]A[218]"
2509 C4$="2[216]3[216]4[216]5[216]6[216]7[216]8[216]9[216]T[216]J[216]Q[216]K[216]A[216]"
2510 FORI=0TO3
2515 IFSU(I)=65THENC1=1:GOSUB2550
2520 IFSU(I)=83THENC2=1:GOSUB2560
2525 IFSU(I)=90THENC3=1:GOSUB2570
2530 IFSU(I)=88THENC4=1:GOSUB2580
2535 NEXT
2540 IFC1=0THENC$=C$+C1$
2541 IFC2=0THENC$=C$+C2$
2542 IFC3=0THENC$=C$+C3$
2543 IFC4=0THENC$=C$+C4$
2545 FORI=0TO3:FORJ=R(I)TO12:GOSUB500:GOSUB550:NEXT:NEXT
2546 GOSUB4100:GOSUB2045:RETURN
2550 C$=C$+MID$(C1$,2*R(I)+1):RETURN
2560 C$=C$+MID$(C2$,2*R(I)+1):RETURN
2570 C$=C$+MID$(C3$,2*R(I)+1):RETURN
2580 C$=C$+MID$(C4$,2*R(I)+1):RETURN
2800 REM* PRINT NEXT PASS
2810 FORI=1TO10:PRINTP1$:POKESID+1,10
2820 FORK=1TO20:NEXT
2830 PRINTP$:POKESID+1,150
2840 FORK=1TO20:NEXT
2850 NEXT:POKESID+1,0:RETURN
3000 REM************************
3001 REM* *
3002 REM* ROUTINE FOR N$="2" *
3003 REM* *
3004 REM************************
3005 QC=0:WW=0:QN=0
3006 IFMID$(A$,3,1)="/"THENQC=1:QN=VAL(MID$(A$,4,1))
3010 FORL=1TO4
3012 IFSJ(L)<>0THEN3020
3014 IFQC<>1THEN3018
3016 IFSI(L)<>QN-1THEN3020
3018 LL=L:L=4:WW=1
3020 NEXT
3025 IFWW=0THENRETURN
3026 WW=0:I1=SI(LL):J1=SJ(LL)
3030 FORII=0TO3:FORJJ=0TO12
3040 IFCN(II,JJ)<>50THEN3070
3050 IFCY(II,JJ)<>ASC(Y$)-128THEN3070
3060 I=II:J=JJ:GOSUB500:GOSUB550:II=3:JJ=12
3070 NEXT
3071 NEXT
3075 CN(I,J)=-1:CY(I,J)=-1
3080 SI(LL)=I:SJ(LL)=J
3090 CN(I1,J1)=50:CY(I1,J1)=ASC(Y$)-128
3110 I=I1:J=J1:GOSUB1000
3120 POKEC(I,J)-2*WD+1,50:POKEC(I,J)-WD+1,ASC(Y$)-128
3130 RETURN
4000 REM****************************
4001 REM* *
4002 REM* CARD CORNERS IDENTIFIED *
4003 REM* *
4004 REM****************************
4010 FORI=0TO3
4020 FORJ=0TO12
4030 C(I,J)=CRT+WD*(3+5*I)+J*INT(WD/13)
4040 NEXT:NEXT:RETURN
4100 REM*****************
4101 REM* *
4102 REM* CARD OUTLINES *
4103 REM* *
4104 REM*****************
4145 POKESID+4,17
4150 FORI=0TO3
4160 FORJ=R(I)TO12
4165 POKESID+1,10+100*RND(1)
4170 GOSUB1000
4180 NEXT:NEXT
4185 POKESID+4,0:RETURN
4200 REM***********
4201 REM* *
4202 REM* DELAY *
4203 REM* *
4204 REM***********
4205 FORDL=1TO10:X=TAN(DL):NEXT
4210 RETURN
4300 REM***************
4301 REM* *
4302 REM* FIND ACES *
4303 REM* *
4304 REM***************
4305 L=1
4310 FORI=0TO3:FORJ=0TO12
4320 IFCN(I,J)=1THENSI(L)=I:SJ(L)=J:L=L+1:GOSUB500
4330 NEXT:NEXT:RETURN
4400 REM**************************
4401 REM* *
4402 REM* REMOVE ACE INTERIORS *
4403 REM* *
4404 REM**************************
4410 FORL=1TO4:I=SI(L):J=SJ(L):GOSUB550
4420 CN(SI(L),SJ(L))=-1:CY(SI(L),SJ(L))=-1:NEXT
4430 RETURN
4500 REM****************
4501 REM* *
4502 REM* NEXT CARD? *
4503 REM* *
4504 REM****************
4505 GOSUB63800
4510 PRINT"";:FORL=1TO23:PRINT"";:NEXT
4520 INPUT"CARD TO BE MOVED [214] [157][157][157][157][157][157][157][157][157]";A$:IFA$="[214]"THEN4500
4540 PRINT"[144]":RETURN
4600 REM******************************
4601 REM* *
4602 REM* SPACE FOR SELECTED CARD? *
4603 REM* *
4604 REM******************************
4605 QQ=0
4610 FORL=1TO4:IFSJ(L)=0THEN4650
4620 IFCN(SI(L),SJ(L)-1)<>KTHEN4650
4630 IFCY(SI(L),SJ(L)-1)<>ASC(Y$)-128THEN4650
4640 LL=L:QQ=1: REM* "L" IS SPACE
4650 NEXT
4660 RETURN
8000 REM******************
8001 REM* *
8002 REM* FINALE *
8003 REM* *
8004 REM******************
8100 PRINT"CONGRATULATIONS!":FORI=0TO15:POKE176,I
8110 GOSUB63820:FORK=1TO50:NEXT:NEXT:GOSUB63800
8120 GOTO20070
10000 REM******************
10001 REM* *
10002 REM* INSTRUCTIONS *
10003 REM* *
10004 REM******************
10005 PRINT:PRINT"[144] WANT INSTRUCTIONS?"
10010 GETA$:IFA$=""THEN10010
10015 PRINT"[147]"
10020 IFA$<>"Y"THENRETURN
10050 PRINT"[147] [144]":POKE53281,15
10100 PRINT"[209]I DEAL 52 CARDS AND REMOVE THE ACES"
10200 PRINT" CREATING 4 'SPACES'."
10300 PRINT"[209]YOU MAY THEN MOVE A CARD INTO A SPACE"
10400 PRINT" BUT[160]THE CARD YOU MOVE MUST BE THE"
10500 PRINT" NEXT CARD IN SEQUENCE!"
10600 PRINT" (ONLY THE JACK OF CLUBS=J[216] MAY"
10700 PRINT" FOLLOW THE TEN OF CLUBS=T[216], ETC.)"
10800 PRINT"[209]YOU MUST FINALLY GET ONE SUIT TO A ROW"
10900 PRINT" ALL IN ORDER..2[211] 3[211] 4[211] ETC.ETC."
11000 PRINT"[209]THE 2'S GO IN THE LEFTMOST SPACES."
11100 PRINT" IF THERE ARE SEVERAL LEFTMOST SPACES,"
11200 PRINT" YOU MAY TYPE "CHR$(34)"2[218]/3"CHR$(34)" MEANING:"
11250 PRINT" "CHR$(34)"PUT THE 2[218] ON THE 3RD LINE."CHR$(34)
11260 PRINT"[209]YOU HAVE SEVERAL TRIES (OR "CHR$(34)"PASSES"CHR$(34)")"
11300 PRINT"(PRESS SPACE[146] TO CONTINUE)":POKE53280,6
11400 GETA$:IFA$=""THEN11400
11500 PRINT"[147]":POKE53280,15:RETURN
20000 REM***********************
20001 REM* *
20002 REM* CHECK FOR STALEMATE *
20003 REM* *
20004 REM***********************
20005 C1=0
20010 FORL=1TO4
20015 IFSJ(L)=0THENL=4:GOTO20040
20020 IFCN(SI(L),SJ(L)-1)=-1THENC1=C1+1:GOTO20040
20030 IFCN(SI(L),SJ(L)-1)=11THENC1=C1+1
20040 NEXT
20050 IFC1<4THENNQ=0:RETURN
20060 NQ=1:PASS=PASS+1:RETURN
20070 PRINT"";:FORL=1TO23:PRINT"";:NEXT:PRINT" ";
20080 PRINT"LIKE ANOTHER GAME?[146] ";
20090 GETA$
20100 IFA$=""THEN20090
20110 IFA$="Y"THENRUN
20120 END
21000 REM*********
21001 REM* *
21002 REM* DIRGE *
21003 REM* *
21004 REM*********
21700 SID=54272:P=SID+1:T=2:POKESID+4,33:POKESID+6,10*16+8:POKESID+24,15
21725 POKEP,18:FORX=1TO300*T:NEXT:GOSUB21790
21735 POKEP,18:FORX=1TO200*T:NEXT:GOSUB21790
21740 POKEP,18:FORX=1TO100*T:NEXT:GOSUB21790
21742 POKEP,18:FORX=1TO300*T:NEXT:GOSUB21790
21745 POKEP,21:FORX=1TO300*T:NEXT:GOSUB21790
21750 POKEP,20:FORX=1TO200*T:NEXT:GOSUB21790
21755 POKEP,18:FORX=1TO100*T:NEXT:GOSUB21790
21760 POKEP,18:FORX=1TO200*T:NEXT:GOSUB21790
21765 POKEP,16:FORX=1TO100*T:NEXT:GOSUB21790
21770 POKEP,18:FORX=1TO300*T:NEXT
21790 FORX=1TO5:NEXT:POKEP,0:RETURN
50000 REM*************
50001 REM* *
50002 REM* TITLE *
50003 REM* *
50004 REM*************
50005 PRINT"[147][144]":POKE53281,15:POKE53280,15:SID=54272
50010 PRINTSPC(6)" [223][169] [146] [146] [146] [146] [146] [146] [146] [146] [146]"
50015 PRINTSPC(6)" [146][223][169] [146] [146] [146] [146] [146] [146] [146] [146] [146] [146] [146] [146]"
50020 PRINTSPC(6)" [146] [146] [146] [146] [223] [146] [146] [146] [223] [146] [146]"
50030 PRINTSPC(6)" [146] [146] [146] [146] [146][223] [146] [146] [146] [146] [146][223] [146] [146] [146]"
50040 PRINTSPC(6)" [146] [146] [146] [146] [146] [146] [146] [146] [146] [146] [146] [146]"
50045 P1$=" "
50046 P$="PASS 1 OF"+TT$
50047 A1$="YOU GOTTA BE KIDDIN'"
50048 A2$="AW...C'MON NOW!!"
50049 A3$="WELL..THAT'S AN EASY GAME!"
50050 A4$="CONGRATULATIONS!"
50051 FORI=0TO28:POKESID+I,0:NEXT
50052 POKESID+6,240:POKESID+24,15:POKESID+1,100
50055 GOSUB63000:GOSUB63700:FORI=0TO10:POKE176,I:GOSUB63820:FORT=1TO50:NEXT
50060 NEXT:RETURN
62000 REM* NUMBER OF PASSES? *
62100 INPUT"HOW MANY TRIES WOULD YOU LIKE 3[157][157][157]";TT$
62150 PRINT"[147]":PRINT"[144]"
62200 TT=VAL(TT$)
62300 IFTT=0THEN62100
62350 PRINT"[147]":P$=P$+TT$
62355 IFTT>8THENPRINTA1$:GOTO62370
62360 IFTT>5THENPRINTA2$:GOTO62370
62365 IFTT>3THENPRINTA3$:GOTO62370
62370 FORK=1TO500:NEXT
62400 PRINT"[147]":RETURN
62500 REM******************
62501 REM* *
62502 REM* END OF GAME *
62503 REM* *
62504 REM******************
63000 REM* SCREEN FLASH ROUTINE *
63010 RESTORE:FORMM=832TO869
63020 READMC:POKEMM,MC:NEXT:RETURN
63030 :
63040 DATA 162,0,189,0,4,73,128,157,0,4,189,0,5,73,128,157,0,5,189,0,6,73,128
63060 DATA 157,0,6,189,0,7,73,128,157,0,7,202,208,221,96
63130 REM** A WIN! **
63135 IFPASS>4THEN8000
63140 FORTM=1TO20:SYS832:POKESID+24,15
63150 POKESID+1,250-12*TM:POKESID+4,17
63160 FORK=1TO50:NEXT:POKE176,16*RND(1):GOSUB63820
63170 POKESID+1,0:NEXT
63180 GOTO20070
63700 REM ROUTINE AT $7FOO FILLS MEMORY
63710 REM WITH A PRESCRIBED FILL BYTE.
63720 REM POKE 174/175,STARTING ADDRESS
63730 REM POKE 176,FILL BYTE
63740 REM POKE 177,NUMBER OF PAGES
63750 REM SYS ML TO FILL MEMORY
63760 ML=7*4096+15*256:POKE53281,15
63770 FORI=0TO16:READX:POKEML+I,X:NEXT
63780 RETURN
63790 DATA 165,176,166,177,160,0,145,174,200,208,251,230,175,202,208,246,96
63800 REM FILL MEMORY PAGES
63810 POKE176,0:REM COLOUR
63820 POKE174,0:POKE175,216:REM NYBBLES
63830 POKE177,4:REM PAGES
63840 SYSML:RETURN